home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Yerk 3.6.6 / Float source / fpCode < prev    next >
Encoding:
Text File  |  1990-12-22  |  6.0 KB  |  186 lines  |  [TEXT/YERK]
  1. d7
  2.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  3.         jmp     (a2)
  4. ;CODE
  5.  
  6. \ =================== Comparison operators ==============
  7. \ Stack frame for all comparisons:
  8. \ ( float1 float2 -- bool )
  9. :CODE f>
  10.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  11.         jsr     0(a3,d7.l)           ; go kill floats in D0,D1
  12.         MOVE.W  #8,-(A7)    ; code for FCMPX
  13.         call    pack4
  14.         sgt     D0
  15.         move.l  D0,-(A7)
  16. ;CODE
  17.  
  18. :CODE f<
  19.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  20.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  21.         MOVE.W  #8,-(A7)    ; code for FCMPX
  22.         call    pack4           
  23.         slt     D0
  24.         move.l  D0,-(A7)
  25. ;CODE
  26.  
  27. :CODE f=  
  28.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  29.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  30.         MOVE.W  #8,-(A7)    ; code for FCMPX
  31.         call pack4           
  32.         seq     D0
  33.         move.l  D0,-(A7)
  34. ;CODE
  35.  
  36. :CODE f<>  
  37.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  38.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  39.         MOVE.W  #8,-(A7)    ; code for FCMPX
  40.         call pack4           
  41.         sne     D0
  42.         move.l  D0,-(A7)
  43. ;CODE
  44.  
  45. :CODE f<=  
  46.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  47.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  48.         MOVE.W  #8,-(A7)    ; code for FCMPX
  49.         call pack4           
  50.         sle     D0
  51.         move.l  D0,-(A7)
  52. ;CODE
  53.  
  54. :CODE f>=  
  55.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  56.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  57.         MOVE.W  #8,-(A7)    ; code for FCMPX
  58.         call pack4           
  59.         sge     D0
  60.         move.l  D0,-(A7)
  61. ;CODE
  62.  
  63. \ ================ Arithmetic operators ==============
  64. \ ( flt1 flt2 -- abs2 abs1)  set up stack for operator, kill float in d0
  65. :CODE  (fp1)      \ ***** subroutine ****
  66.         move.l  (A7)+,a2    ; hold return address 
  67.         move.l  (A7)+,D0    ; get 2 floats in D0,D1
  68.         move.l  (A7)+,D1    ; 
  69.         pea     2(A3,D0.l)  ; push abs data addresses       
  70.         pea     2(A3,D1.l)  ; example op:  f1 - f2 -> f1       
  71.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  72.         jsr     0(a3,d7.l)              ; go kill float in D0
  73.         jmp     (a2)
  74. ;CODE
  75. \ --------------------------------------
  76. \ ( f1 f2 -- f1+f2)  result gets stored in f2's data 
  77. :CODE f+  
  78.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  79.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  80.         clr.w   -(A7)    ; code for FADD
  81.         call pack4           
  82.         move.l  D1,-(A7)    ; 
  83. ;CODE
  84.  
  85. :CODE f-  
  86.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  87.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  88.         MOVE.W  #2,-(A7)    ; code for FSUB
  89.         call pack4           
  90.         move.l  D1,-(A7)    ; 
  91. ;CODE
  92.  
  93. :CODE f*  
  94.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  95.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  96.         MOVE.W  #4,-(A7)    ; code for FMULT
  97.         call pack4           
  98.         move.l  D1,-(A7)    ; 
  99. ;CODE
  100.  
  101. :CODE f/  
  102.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  103.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  104.         MOVE.W  #6,-(A7)    ; code for FDIV
  105.         call pack4           
  106.         move.l  D1,-(A7)    ; 
  107. ;CODE
  108.  
  109. \ floating point modulus function
  110. :CODE fMod        
  111.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  112.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  113.         MOVE.W  #12,-(A7)               ; code for FREM
  114.         call pack4           
  115.         move.l  D1,-(A7)    ; 
  116. ;CODE
  117.  
  118.  
  119. \ ============= unary operations ==============
  120. :CODE fNegate  
  121.         move.l  (A7),D0
  122.         pea     2(A3,D0.l)         
  123.         MOVE.W  #13,-(A7)     
  124.         call pack4           
  125. ;CODE
  126.  
  127. :CODE fAbs  
  128.         move.l  (A7),D0
  129.         pea     2(A3,D0.l)         
  130.         MOVE.W  #15,-(A7)     
  131.         call pack4           
  132. ;CODE
  133.  
  134. :CODE sqrt  
  135.         move.l  (A7),D0
  136.         pea     2(A3,D0.l)         
  137.         MOVE.W  #18,-(A7)     
  138.         call pack4           
  139. ;CODE
  140.  
  141. :CODE round  
  142.         move.l  (A7),D0
  143.         pea     2(A3,D0.l)         
  144.         MOVE.W  #20,-(A7)     
  145.         call pack4           
  146. ;CODE
  147.  
  148. :CODE trunc  
  149.         move.l  (A7),D0
  150.         pea     2(A3,D0.l)         
  151.         MOVE.W  #22,-(A7)     
  152.         call pack4           
  153. ;CODE
  154.  
  155. :CODE logBin  
  156.         move.l  (A7),D0
  157.         pea     2(A3,D0.l)         
  158.         MOVE.W  #26,-(A7)     
  159.         call pack4           
  160. ;CODE
  161.  
  162. \ ========= conversion to/from Yerk longInt  
  163. ( flt -- int32)
  164. :CODE float>  
  165.         move.l  (A7),D0             ; get source float
  166.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  167.         jsr     0(a3,d7.l)             ; go kill floats in D0 
  168.         move.l  (A7),D0             ; get source float
  169.         move.l  a7,a0           ; save ptr to the cell
  170.         pea     2(A3,D0.l)         
  171.         move.l  a0,-(a7)        ; push ptr to the cell 
  172.         MOVE.W  #10256,-(A7)    ; $2810   
  173.         call pack4           
  174. ;CODE
  175.  
  176. \ ( int32 -- fp )
  177. :CODE >float  
  178.         move.l  a7,-(a7)    ; push ptr to the long
  179.         move.l  YERK[(fltNew)],d7       ; get subr addr in d7
  180.         jsr     0(a3,d7.l)              ; go get float in D1
  181.         pea     2(a3,d1.l)                ; push addr of float
  182.         MOVE.W  #10254,-(A7)            ; $280e
  183.         call pack4           
  184.         move.l  D1,(A7)    ;  replace the long cell with float ptr
  185. ;CODE
  186.